home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / snobol / vsnobol / budget.sno < prev    next >
Text File  |  1991-02-14  |  4KB  |  113 lines

  1. *    BUDGET - Assistance for those who must verbalize the
  2. *        U.S. budget deficit for the years to come.
  3. *
  4. *    Takes a number of up to 30 digits long, and spells it out.
  5. *    Eliminates the embarrassment of having to stand up at a press
  6. *    conference and say: "Ah, well, you know, it's a 1 with
  7. *    seventeen zeros after it."
  8. *
  9. *    Be prepared!  The future is almost here.
  10. *
  11. *    Uses American conventions:
  12. *       Million, Billion, Trillion, Quadrillion, Quintillion,
  13. *       Sextillion, Septillion, Octillion.
  14. *
  15. *
  16. *    Copyright 1987 Catspaw, Inc.
  17. *
  18. *    SPELL function from Gimpel, "Algorithms in SNOBOL4"
  19. *
  20.     DEFINE('SPELL(N)M')
  21.     SPELL_PAT = POS(0) RTAB(4) ('LION' | 'SAND') RPOS(0) . M
  22.     ZERO_PAT = POS(0) SPAN('0')            :(SPELL_END)
  23. * Entry point.  Strip leading zeros.
  24. SPELL    N ZERO_PAT =
  25.  
  26. * Dispatch to different labels depending on the size of N.
  27.     GE(SIZE(N),10)                    :S(SPELL_BILL)
  28.     GE(SIZE(N),4)                    :S(SPELL_1000)
  29.     GE(N,100)                    :S(SPELL_100)
  30.     GE(N,20)                    :S(SPELL_20)
  31.     GE(N,13)                    :S(SPELL_13)
  32.  
  33. * Process N from 0 (null) to 12 via string lookup.
  34.     (',1ONE,2TWO,3THREE,4FOUR,5FIVE,6SIX,7SEVEN,8EIGHT,9NINE,'
  35. +     '10TEN,11ELEVEN,12TWELVE,')  N BREAK(',') . SPELL    :(RETURN)
  36.  
  37. * Here for N from 13 to 19.  Do like 30-90, then substitute 'TEEN'
  38. *  for 'TY' afterword.  Demonstrates recursion and number-string conversion.
  39. SPELL_13 N 1 LEN(1) . M
  40.     SPELL = SPELL(M 0)
  41.     SPELL 'TY' = 'TEEN'
  42.     SPELL 'FOR' = 'FOUR'                :(RETURN)
  43.  
  44. * Here for N from 20 to 99
  45. SPELL_20 N LEN(1) . M =
  46.     '2TWEN,3THIR,4FOR,5FIF,6SIX,7SEVEN,8EIGH,9NINE,' M BREAK(',') . SPELL
  47.     SPELL = SPELL 'TY'
  48.     SPELL = NE(N,0) SPELL '-' SPELL(N)        :(RETURN)
  49.  
  50. * Here for N from 100 to 999.  Convert hundreds and tens recursively.
  51. SPELL_100 N LEN(1) . M =
  52.     SPELL = SPELL(M) ' HUNDRED'
  53.     SPELL = NE(N,0) SPELL ' AND ' SPELL(N)        :(RETURN)
  54.  
  55. * Here for numbers between 1,000 and 10**9.  Set M to N/1000, and recurse.
  56. * SPELL_PAT tests for numbers ending with all zeros, like 1,000,000.
  57. * The RPOS(0) . M construct sets M to null as a flag that will suppress
  58. * the ' THOUSAND' suffix.
  59. SPELL_1000 N RTAB(3) . M =
  60.     SPELL = SPELL(M)
  61.     SPELL SPELL_PAT
  62.     SPELL  'THOUSAND' = 'MILLION'
  63.     SPELL = DIFFER(M) SPELL ' THOUSAND'
  64.     SPELL = NE(N,0) SPELL ', ' SPELL(N)        :(RETURN)
  65.  
  66. * Here for numbers of 1,000,000,000 and larger (American usage).
  67. * Same trick is used for M to suppress ' BILLION' suffix.
  68. SPELL_BILL    N RTAB(9) . M =
  69.     SPELL = SPELL(M)
  70.     SPELL SPELL_PAT
  71.     SPELL 'QUINT' = 'OCT'
  72.     SPELL 'QUADR' = 'SEPT'
  73.     SPELL 'TR'    = 'SEXT'
  74.     SPELL 'B'     = 'QUINT'
  75.     SPELL 'M'     = 'QUADR'
  76.     SPELL 'THOUSAND'   = 'TRILLION'
  77.     SPELL = DIFFER(M) SPELL ' BILLION'
  78. * Can't test N directly with NE(), because it may be too large as an integer.
  79. * So remove leading (or all) zeros, and see if anything left.
  80.     N ZERO_PAT =
  81.     SPELL = NE(SIZE(N),0) SPELL ' ' SPELL(N)    :(RETURN)
  82. SPELL_END
  83.  
  84.  
  85. *    PRINT(S)
  86. *
  87. *    Function to print a string S, breaking lines at the first
  88. *    space or hyphen after the 65th character on each line.
  89. *
  90.     DEFINE('PRINT(S)')
  91.     PRINT_PAT = POS(0) (LEN(65) BREAK('- ') ANY('- ') ) . OUTPUT
  92.                             :(PRINT_END)
  93. PRINT    S PRINT_PAT =                    :S(PRINT)
  94.     OUTPUT = S                    :(RETURN)
  95. PRINT_END
  96.  
  97.  
  98. ****  MAIN PROGRAM ****
  99.     &TRIM = 1
  100.     OUTPUT = "U.S. Budget Deficit Pronoucer"
  101.     OUTPUT = "Numbers with up to 30 digits are allowed (commas permitted)"
  102.     OUTPUT = "Type Control-Z to terminate."
  103.  
  104. MAIN    OUTPUT = "Enter Deficit: " CHAR(26)
  105.     NUMBER = INPUT                    :F(END)
  106. STRIP    NUMBER ANY('$,') =                :S(STRIP)
  107.     NUMBER POS(0) SPAN('0123456789') RPOS(0)    :F(ERROR)
  108.     LE(SIZE(NUMBER),30)                :F(ERROR)
  109.  
  110.     PRINT(SPELL(NUMBER) ' DOLLARS')            :(MAIN)
  111. ERROR    OUTPUT = "Must be numeric and 30 or fewer digits"    :(MAIN)
  112. END
  113.